home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 8 / QRZ Ham Radio Callsign Database - Volume 8.iso / mac / files / ant_nec / nec81tar.z / nec81tar / mainsa.f < prev    next >
Text File  |  1991-05-13  |  40KB  |  1,357 lines
  1. C $TITLE: 'MAIN'
  2. C $NOFLOATCALLS
  3. C     PROGRAM NEC(INPUT,TAPE5=INPUT,OUTPUT,TAPE11,TAPE12,TAPE13,TAPE14,
  4. C    1TAPE15,TAPE16,TAPE20,TAPE21)
  5. C
  6. C     NUMERICAL ELECTROMAGNETICS CODE 'NEC-81', v2.2, 13 DEC 88
  7. C     PC VERSION DEVELOPED BY DAVID J. PINION, P.E.
  8. C
  9. C**
  10. C***  ==================================================================
  11. C***
  12. C***    ADDITIONS TO NEC-81 BY R W ADLER, 03 APR 89 FOR USE IN
  13. C***                      NEEDS 2.0.
  14. C***
  15. C***                  LOG OF ADDITIONS
  16. C***                  ++++++++++++++++
  17. C***
  18. C***    1. THE PT CARD ADDITIONS FOR RCV CURRENT OUTPUTS/IPTFLG 8 & 9
  19. C***          (MAIN)
  20. C***
  21. C***    2. THE GP GARD WHICH TURNS OFF GEOMETRY PRINT
  22. C***          (DATAGN)
  23. C***
  24. C***    3. THE GM CARD OPTION WHICH ALLOWS SELECTED-TAG MOVES
  25. C***          (DATAGN, MOVE)
  26. C***
  27. C***    4. THE PL CARD: A. IPLP4 = 4 FOR V, H, & TOTAL GAINS
  28. C***                         (RDPAT)
  29. C***                    B. IPLP2 = 3 FOR GROUND WAVE FIELD PLOTS
  30. C***                         (RDPAT)
  31. C***                    C. THE GE1,1 OPTION FOR GTD OUTPUTS (NEC-BSC)
  32. C***                         (MAIN, DATAGN)
  33. C***                    D. THE GE1,2 OPTION FOR CURRPLOT OUTPUTS
  34. C***                         (MAIN, DATAGN)
  35. C***                    E. IPLP1 = 4 FOR FREQ, Z, Z', & VSWR
  36. C***                         (MAIN)
  37. C***                    F. IPLP1 = 5 FOR FREQ, Y, Y', & VSWR
  38. C***                         (MAIN)
  39. C***
  40. C***
  41. C***    5. ADD VSWR CALCULATIONS TO THE IMPEDANCE TABLE
  42. C***        PRODUCED BY THE EX CARD OPTIONS
  43. C***          (MAIN)
  44. C***
  45. C***    6. ADD AN ADMITTANCE TABLE TO THE LISTING WHEN REQUESTING
  46. C***        THE IMPEDANCE TABLE IN THE EX CARD OPTIONS
  47. C***          (MAIN)
  48. C***
  49. C***  =================================================================
  50. C***
  51. C***  LISAA PUUKOTUSTA P.KOTILAISEN TOIMESTA 28.2.1990
  52. C*** 
  53. C***  TAMA VERSIO TOIMII AINAKIN SUN-4 SPARCSTATIONILLA
  54. C***
  55. C***  EDELLEEN PUUKOTUSTA 1.4.1991 ...
  56. C***
  57. C***  DIMENSIOITA MUUTETTU, MAX. SEGMENTTIMAARA NYT 3000
  58. C***
  59. C***  =================================================================
  60. C***
  61. C      PARAMETER(IRESRV= 8100)
  62.       PARAMETER(IRESRV= 1000000)
  63. C      PARAMETER(LD = 300)
  64.       PARAMETER(LD = 3000)
  65.       PARAMETER(LD2=2*LD)
  66.       PARAMETER(LD3=3*LD)
  67.       PARAMETER(LD4=4*LD)
  68. C**
  69.       CHARACTER AIN*2,ATST*2,PNET*8,HPOL*6
  70. C***
  71. C***    READ FROM \NEEDS\DATA\  RWA  1 LINE  10 JUN 89
  72. C***
  73.       CHARACTER*31 INPUTFILE
  74. C***
  75. C***    WRITE TO \NEEDS\NEC\  RWA  1 LINE  10 JUN 89
  76. C***
  77.       CHARACTER*31 OUTPUTFILE
  78. C**
  79.       INTEGER*4 ICON1,ICON2,ITAG,ICONX,N1,N2,N,NP,M1,M2,M,MP,IPSYM
  80.       INTEGER*4 NPEQ,NEQ,NEQ2,IB11,IC11,ID11,IX11,IND1,IND2
  81.       INTEGER*4 IMAT,NPBLK,NLAST,NLSYM,NBBX,NPBX,NLBX,NBBL,NPBL,NLBL
  82.       REAL*8 GAIN,AX,BX,CX,AIR,AII,BIR,BII,CIR,CII
  83.       REAL*8 TA,R1,R2,ZMH,ZPH,DB20,CANG,CMAG,PH,FR2
  84. C***
  85. C***    ADMITTANCE STUFF  RWA 28 MAR 89   ADD 1 LINE
  86. C***
  87.       REAL*8 YPNORM,ZPNORM
  88. CLARGE: CM,CMN,CUR,RHS,RHNT
  89.       COMPLEX CM,CMN,CUR,RHS,RHNT,SR1,SR2,SR3,SPSCF
  90.       COMPLEX*16 SCRATC
  91.       COMPLEX*16 U,U2,XX1,XX2,CURI,ETH,EPH,EX,EY,EZ
  92.       COMPLEX*16 VQD,VSANT,VQDS,Y11A,Y12A
  93.       COMPLEX*16 VSRC,RHNX,SSX,ZARRAY,ZPED
  94.       COMPLEX*16 EXK,EYK,EZK,EXS,EYS,EZS,EXC,EYC,EZC,ZRATI,ZRATI2,
  95.      1 T1,FRATI,EPSC
  96.       REAL*4 DXA,DYA,XSA,YSA
  97.       COMPLEX*8 AR1,AR2,AR3,EPSCF
  98.       COMPLEX FJ
  99.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  100.       COMMON/DATAJ/S,B,XJ,YJ,ZJ,CABJ,SABJ,SALPJ,EXK,EYK,EZK,EXS,EYS,
  101.      1 EZS,EXC,EYC,EZC,RKH,IND1,IND2,IPGND,IEXK
  102.       COMMON/MATPAR/ICASE,NBLOKS,NPBLK,NLAST,NBLSYM,NPSYM,NLSYM,IMAT,
  103.      1ICASX,NBBX,NPBX,NLBX,NBBL,NPBL,NLBL
  104.       COMMON/SAVE/KCOM,COM(19,5),EPSR,SIG,SCRWLT,SCRWRT,FMHZ
  105.       COMMON/GND/ZRATI,ZRATI2,FRATI,CL,CH,SCRWL,SCRWR,NRADL,KSYMP,
  106.      1 IFAR,IPERF,T1,T2
  107.       COMMON/ZLOAD/ NLOAD,NLODF
  108.       COMMON/YPARM/NCOUP,ICOUP,NCTAG(5),NCSEG(5),Y11A(5),Y12A(20)
  109.       COMMON/SEGJ/AX(30),BX(30),CX(30),JCO(30),JSNO,ISCON(50),NSCON,
  110.      1IPCON(10),NPCON
  111.       COMMON/VSORC/VQD(30),VSANT(30),VQDS(30),IVQD(30),ISANT(30),
  112.      1IQDS(30),NVQD,NSANT,NQDS
  113.       COMMON/NETCX/ZPED,PIN,PNLS,NEQ,NPEQ,NEQ2,NONET,NTSOL,NPRINT,
  114.      1MASYM,ISEG1(30),ISEG2(30),X11R(30),X11I(30),X12R(30),X12I(30),
  115.      1X22R(30),X22I(30),NTYP(30)
  116.       COMMON/NETWKC/CMN(30,30),RHNT(30),IPNT(30),NTEQA(30),NTSCA(30),
  117.      1 VSRC(30),RHNX(30),NAMPRT
  118.       COMMON/FPAT/NTH,NPH,IPD,IAVP,INOR,IAX,THETS,PHIS,DTH,DPH,
  119.      1RFLD,GNOR,CLT,CHT,EPSR2,SIG2,IXTYP,XPR6,PINR,PNLR,PLOSS,
  120.      1NEAR,NFEH,NRX,NRY,NRZ,XNR,YNR,ZNR,DXNR,DYNR,DZNR
  121.       COMMON/GGRID/AR1(11,10,4),AR2(17,5,4),AR3(9,8,4),EPSCF,DXA(3),
  122.      1DYA(3),XSA(3),YSA(3),NXA(3),NYA(3)
  123.       COMMON/GWAV/U,U2,XX1,XX2,R1,R2,ZMH,ZPH
  124.       COMMON/PLOT/ IPLP1,IPLP2,IPLP3,IPLP4
  125.       COMMON/SMAT/SSX(16,16)
  126. C
  127.       DIMENSION ATST(22),PNET(3),HPOL(3)
  128.       DIMENSION IP(LD2),IX(LD2),ICON1(LD),ICON2(LD),ITAG(LD),ICONX(LD)
  129.       DIMENSION LDTYP(30),LDTAG(30),LDTAGF(30),LDTAGT(30),ZLR(30),
  130.      1ZLI(30),ZLC(30)
  131.       DIMENSION FNORM(200)
  132.       DIMENSION GAIN(LD4),X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  133.       DIMENSION AIR(LD),AII(LD),BIR(LD),BII(LD),CIR(LD),CII(LD)
  134.       DIMENSION CM(IRESRV),CUR(LD3),RHS(LD3),SCRATC(LD2),ZARRAY(LD)
  135.       DIMENSION XTEMP(LD),YTEMP(LD),ZTEMP(LD),SITEMP(LD),BITEMP(LD)
  136.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  137.       EQUIVALENCE (SCRATC,GAIN)
  138. C**
  139.       EQUIVALENCE (T2X,ICON1),(T2Y,ICON2),(T2Z,ICONX)
  140.       DATA ATST/2HCE,2HFR,2HLD,2HGN,2HEX,2HNT,2HXQ,2HNE,2HGD,
  141.      1 2HRP,2HCM,2HNX,2HEN,2HTL,2HPT,2HKH,2HNH,2HPQ,2HEK,2HWG,
  142.      1 2HCP,2HPL/
  143.       DATA HPOL/6HLINEAR,6HRIGHT ,6HLEFT  /
  144.       DATA PNET/8H        ,8HSTRAIGHT,8HCROSSED /
  145.       DATA TA/1.745329252D-02/,CVEL/299.8/
  146. C      DATA LOADMX,NSMAX,NETMX/30,30,30/,NORMF/200/
  147.       DATA LOADMX,NSMAX,NETMX/100,50,100/,NORMF/200/
  148. C      DATA IR/3/,IW/4/,IGFL/20/
  149.       DATA IR/23/,IW/24/,IGFL/20/
  150.       WRITE(*,9000)
  151.       WRITE(*,9001)
  152. 9000      FORMAT(/,26X,'N.E.C. PROGRAM NEC-81',/,
  153.      1 15X,'v2.2, COPYRIGHT 1989, DAVID J. PINION, P.E.',/)
  154. 9001     FORMAT(/,26X,'Modified by OH3MCK 1991 for SUN-4',/)
  155.  
  156.       CALL SECOND(EXTIM)
  157.       FJ=(0.,1.)
  158.       NXA(1)=0
  159. C***
  160. C***    STAND-ALONE READ-WRITE
  161. C***
  162.       WRITE(*,'(A,I2,A)') ' OPEN UNIT ',IR,' FOR NEC INPUT  FILE'
  163.       READ(*,'(A)') INPUTFILE
  164.       WRITE(*,'(A,I2,A)') ' OPEN UNIT ',IW,' FOR NEC OUTPUT FILE'
  165.       READ(*,'(A)') OUTPUTFILE
  166. 1     KCOM=0
  167. C***
  168. C***    READ FROM \NEEDS\DATA\  RWA  4 LINES  10 JUN 89
  169. C***
  170. C**   WRITE(*,'(A,I2,A)') ' OPEN UNIT ',IR,' FOR NEC INPUT  FILE - \NEED
  171. C**  |S\DATA\input filename.NEC'
  172. C      READ(*,'(A)') INPUTFILE
  173.  
  174. C**   OPEN (UNIT=3,FILE='\NEEDS\DATA\'//INPUTFILE//'.NEC',STATUS='OLD')
  175.       OPEN (UNIT=23,FILE=INPUTFILE, STATUS='OLD')
  176. C**   WRITE(*,'(A,I2,A)') ' OPEN UNIT ',IW,' FOR NEC OUTPUT FILE - \NEED
  177. C**  |S\NEC\output filename.OUT'
  178. C***
  179. C***    WRITE TO \NEEDS\NEC\  RWA  2 LINES  10 JUN 89
  180. C***
  181. C      READ(*,'(A)') OUTPUTFILE
  182. C**   OPEN (UNIT=4,FILE='\NEEDS\NEC\'//OUTPUTFILE//'.OUT')
  183.       OPEN (UNIT=24,FILE=OUTPUTFILE, STATUS='NEW')
  184. C***
  185.       IFRTMW=0
  186.       IFRTMP=0
  187. C***
  188. 2     KCOM=KCOM+1
  189.       IF (KCOM.GT.5) KCOM=5
  190. 1000      CONTINUE
  191.       READ(IR,125)AIN,(COM(I,KCOM),I=1,19)
  192.       IF(KCOM.GT.1)GO TO 3
  193.       WRITE(IW,126)
  194.       WRITE(IW,127)
  195.       WRITE(IW,128)
  196. 3     WRITE(IW,129) (COM(I,KCOM),I=1,19)
  197.       IF (AIN.EQ.ATST(11)) GO TO 2
  198.       IF (AIN.EQ.ATST(1)) GO TO 4
  199.       WRITE(IW,130)
  200.       STOP
  201. 4     CONTINUE
  202.       DO 5 I=1,LD
  203. 5     ZARRAY(I)=DCMPLX(0.,0.)
  204.       MPCNT=0
  205.       IMAT=0
  206. C
  207. C     SET UP GEOMETRY DATA IN SUBROUTINE DATAGN
  208. C
  209. CD      WRITE(*,'(A)') 'MAIN: CALL DATAGN'
  210.  
  211.       CALL  DATAGN(CM,ZARRAY,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,
  212.      1 ICON1,ICON2,ITAG,ICONX,IP,LD,LD2,IRESRV,IR,IW,IGFL)
  213.  
  214. CD      WRITE(*,'(A)') 'MAIN: RTRN DATAGN'
  215.  
  216.       IF(IMAT.EQ.0)GO TO 326
  217. C
  218. C     CORE ALLOCATION FOR ARRAYS B, C, AND D FOR N.G.F. SOLUTION
  219. C
  220.       NEQ=2*(M-M1+NPCOM)
  221.       NEQ2=N-N1+NSCON+NEQ
  222.       NEQ=N1+2*M1
  223.  
  224. CD      WRITE(*,'(A)') 'MAIN: CALL FBNGF'
  225.  
  226.       CALL FBNGF(NEQ,NEQ2,IRESRV,IB11,IC11,ID11,IX11,IW)
  227.  
  228. CD      WRITE(*,'(A)') 'MAIN: RTRN FBNGF'
  229.  
  230.       GO TO 6
  231. 326   NEQ=N+2*M
  232.       NEQ2=0
  233.       IB11=1
  234.       IC11=1
  235.       ID11=1
  236.       IX11=1
  237.       ICASX=0
  238. 6     NPEQ=NP+2*MP
  239.       WRITE(IW,135)
  240. C
  241. C     DEFAULT VALUES FOR INPUT PARAMETERS AND FLAGS
  242. C
  243.       IPLP1=0
  244.       IPLP2=0
  245.       IPLP3=0
  246.       IPLP4=0
  247. C***
  248.       IGO=1
  249.       FMHZS=CVEL
  250.       NFRQ=1
  251.       RKH=1.
  252.       IEXK=0
  253.       IXTYP=0
  254.       NLOAD=0
  255.       NONET=0
  256.       NEAR=-1
  257.       IPTFLG=-2
  258.       IPTFLQ=-1
  259.       IFAR=-1
  260.       ZRATI=DCMPLX(1.,0.)
  261.       IPED=0
  262.       IRNGF=0
  263.       NCOUP=0
  264.       ICOUP=0
  265.       IF(ICASX.GT.0)GO TO 14
  266.       FMHZ=CVEL
  267.       NLODF=0
  268.       KSYMP=1
  269.       NRADL=0
  270.       IPERF=0
  271. C
  272. C     MAIN INPUT SECTION - STANDARD READ STATEMENT - JUMPS TO APPRO-
  273. C     PRIATE SECTION FOR SPECIFIC PARAMETER SET UP
  274. C
  275. 14    READ(IR,136)AIN,ITMP1,ITMP2,ITMP3,ITMP4,TMP1,TMP2,TMP3,TMP4,
  276.      1 TMP5,TMP6
  277.       MPCNT=MPCNT+1
  278.       WRITE(IW,137) MPCNT,AIN,ITMP1,ITMP2,ITMP3,ITMP4,TMP1,TMP2,TMP3,
  279.      1TMP4,TMP5,TMP6
  280.       IF (AIN.EQ.ATST(2)) GO TO 16
  281.       IF (AIN.EQ.ATST(3)) GO TO 17
  282.       IF (AIN.EQ.ATST(4)) GO TO 21
  283.       IF (AIN.EQ.ATST(5)) GO TO 24
  284.       IF (AIN.EQ.ATST(6)) GO TO 28
  285.       IF (AIN.EQ.ATST(14)) GO TO 28
  286.       IF (AIN.EQ.ATST(15)) GO TO 31
  287.       IF (AIN.EQ.ATST(18)) GO TO 319
  288.       IF (AIN.EQ.ATST(7)) GO TO 37
  289.       IF (AIN.EQ.ATST(8)) GO TO 32
  290.       IF (AIN.EQ.ATST(17)) GO TO 208
  291.       IF (AIN.EQ.ATST(9)) GO TO 34
  292.       IF (AIN.EQ.ATST(10)) GO TO 36
  293.       IF (AIN.EQ.ATST(16)) GO TO 305
  294.       IF (AIN.EQ.ATST(19)) GO TO 320
  295.       IF (AIN.EQ.ATST(12)) GO TO 1
  296.       IF (AIN.EQ.ATST(20)) GO TO 322
  297.       IF (AIN.EQ.ATST(21)) GO TO 304
  298. C***
  299.       IF (AIN.EQ.ATST(22)) GO TO 330
  300. C***
  301.       IF (AIN.NE.ATST(13)) GO TO 15
  302.  
  303. CD      WRITE(*,'(A)') 'MAIN: CALL SECOND'
  304.  
  305.       CALL SECOND(TMP1)
  306.  
  307. CD      WRITE(*,'(A)') 'MAIN: RTRN SECOND'
  308.  
  309.       TMP1=TMP1-EXTIM
  310.       IF(TMP1.LT.0.) TMP1=TMP1+86400.
  311.       WRITE(IW,201) TMP1/60.
  312. C**
  313. C** INPUT AND OUTPUT COMPLETE WHEN PROGRAM ENDS, FOLLOWING IS
  314. C** NORMAL RUN ENDING POINT:
  315. C**
  316.       CLOSE(IR)
  317.       CLOSE(IW)
  318. C**
  319.       STOP
  320. 15    WRITE(IW,138)
  321.       STOP
  322. C
  323. C     FREQUENCY PARAMETERS
  324. C
  325. 16    IFRQ=ITMP1
  326.       IF(ICASX.EQ.0)GO TO 8
  327.       WRITE(IW,303) AIN
  328.       STOP
  329. 8     NFRQ=ITMP2
  330.       IF (NFRQ.EQ.0) NFRQ=1
  331.       FMHZ=TMP1
  332.       DELFRQ=TMP2
  333.       IF(IPED.EQ.1)ZPNORM=0.D0
  334. C***
  335. C***    ADMITTANCE STUFF - RWA 28 MAR 89 - 1 LINE
  336. C***
  337.       IF(IPED.EQ.1)YPNORM = 1.D69
  338.       IGO=1
  339.       IFLOW=1
  340.       GO TO 14
  341. C
  342. C     MATRIX INTEGRATION LIMIT
  343. C
  344. 305   RKH=TMP1
  345.       IF(IGO.GT.2)IGO=2
  346.       IFLOW=1
  347.       GO TO 14
  348. C
  349. C     EXTENDED THIN WIRE KERNEL OPTION
  350. C
  351. 320   IEXK=1
  352.       IF(ITMP1.EQ.-1)IEXK=0
  353.       IF(IGO.GT.2)IGO=2
  354.       IFLOW=1
  355.       GO TO 14
  356. C
  357. C     MAXIMUM COUPLING BETWEEN ANTENNAS
  358. C
  359. 304   IF(IFLOW.NE.2)NCOUP=0
  360.       ICOUP=0
  361.       IFLOW=2
  362.       IF(ITMP2.EQ.0)GO TO 14
  363.       NCOUP=NCOUP+1
  364.       IF(NCOUP.GT.5)GO TO 312
  365.       NCTAG(NCOUP)=ITMP1
  366.       NCSEG(NCOUP)=ITMP2
  367.       IF(ITMP4.EQ.0)GO TO 14
  368.       NCOUP=NCOUP+1
  369.       IF(NCOUP.GT.5)GO TO 312
  370.       NCTAG(NCOUP)=ITMP3
  371.       NCSEG(NCOUP)=ITMP4
  372.       GO TO 14
  373. 312   WRITE(IW,313)
  374.       STOP
  375. C
  376. C     LOADING PARAMETERS
  377. C
  378. 17    IF (IFLOW.EQ.3) GO TO 18
  379.       NLOAD=0
  380.       IFLOW=3
  381.       IF (IGO.GT.2) IGO=2
  382.       IF (ITMP1.EQ.(-1)) GO TO 14
  383. 18    NLOAD=NLOAD+1
  384.       IF (NLOAD.LE.LOADMX) GO TO 19
  385.       WRITE(IW,139)
  386.       STOP
  387. 19    LDTYP(NLOAD)=ITMP1
  388.       LDTAG(NLOAD)=ITMP2
  389.       IF (ITMP4.EQ.0) ITMP4=ITMP3
  390.       LDTAGF(NLOAD)=ITMP3
  391.       LDTAGT(NLOAD)=ITMP4
  392.       IF (ITMP4.GE.ITMP3) GO TO 20
  393.       WRITE(IW,140)  NLOAD,ITMP3,ITMP4
  394.       STOP
  395. 20    ZLR(NLOAD)=TMP1
  396.       ZLI(NLOAD)=TMP2
  397.       ZLC(NLOAD)=TMP3
  398.       GO TO 14
  399. C
  400. C     GROUND PARAMETERS UNDER THE ANTENNA
  401. C
  402. 21    IFLOW=4
  403.       IF(ICASX.EQ.0)GO TO 10
  404.       WRITE(IW,303) AIN
  405.       STOP
  406. 10    IF (IGO.GT.2) IGO=2
  407.       IF (ITMP1.NE.(-1)) GO TO 22
  408.       KSYMP=1
  409.       NRADL=0
  410.       IPERF=0
  411.       GO TO 14
  412. 22    IPERF=ITMP1
  413.       NRADL=ITMP2
  414.       KSYMP=2
  415.       EPSR=TMP1
  416.       SIG=TMP2
  417.       IF (NRADL.EQ.0) GO TO 23
  418.       IF(IPERF.NE.2)GO TO 314
  419.       WRITE(IW,390)
  420.       STOP
  421. 314   SCRWLT=TMP3
  422.       SCRWRT=TMP4
  423.       GO TO 14
  424. 23    EPSR2=TMP3
  425.       SIG2=TMP4
  426.       CLT=TMP5
  427.       CHT=TMP6
  428.       GO TO 14
  429. C
  430. C     EXCITATION PARAMETERS
  431. C
  432. 24    IF (IFLOW.EQ.5) GO TO 25
  433.       NSANT=0
  434.       NVQD=0
  435.       IPED=0
  436.       IFLOW=5
  437.       IF (IGO.GT.3) IGO=3
  438. 25      CONTINUE
  439.       IF (ITMP1.GT.0.AND.ITMP1.LT.5) GO TO 27
  440.       IXTYP=ITMP1
  441.       NTSOL=0
  442.       IF(IXTYP.EQ.0) GOTO 205
  443.       IF(IXTYP.EQ.5) GOTO 200
  444.       IF(IXTYP.GT.5) WRITE(*,*) ' ERROR: ILLEGAL EXCITATION TYPE'
  445. C**
  446. C** IXTYP=6 FOR FIELD EXCITATION, USED IN NEC-AM
  447. C** IXTYP=7 FOR POWER INPUT, ALSO USED IN NEC-AM
  448. C**
  449.       GOTO 14
  450. C**
  451. C** FOLLOWING FOR IXTYP=5 CURRENT-SLOPE-DISCONTINUITY VOLTAGE SOURCE
  452. C**
  453. 200      CONTINUE
  454.       NVQD=NVQD+1
  455.       IF((NSANT+NVQD).GT.NSMAX) GOTO 206
  456.       IVQD(NVQD)=ISEGNO(ITMP2,ITMP3,LD,ITAG)
  457.       VQD(NVQD)=DCMPLX(TMP1,TMP2)
  458. C      IF(CABS(VQD(NVQD)).LT.1.D-20) VQD(NVQD)=DCMPLX(1.,0.)
  459.       IF(ZABS(VQD(NVQD)).LT.1.D-20) VQD(NVQD)=DCMPLX(1.,0.)
  460.       GO TO 207
  461. 205   NSANT=NSANT+1
  462.       IF((NSANT+NVQD).LE.NSMAX) GOTO 26
  463. 206   WRITE(IW,141)
  464.       STOP
  465. 26    ISANT(NSANT)=ISEGNO(ITMP2,ITMP3,LD,ITAG)
  466.       VSANT(NSANT)=DCMPLX(TMP1,TMP2)
  467. C      IF(CABS(VSANT(NSANT)).LT.1.D-20) VSANT(NSANT)=DCMPLX(1.,0.)
  468.       IF(ZABS(VSANT(NSANT)).LT.1.D-20) VSANT(NSANT)=DCMPLX(1.,0.)
  469. 207      CONTINUE
  470.       MASYM=ITMP4/10
  471.       IPED=ITMP4-MASYM*10
  472.       ZPNORM=TMP3
  473. C***
  474. C***    ADMITTANCE STUFF - RWA 28 MAR 89 - 5 LINES
  475. C***
  476.       IF (ZPNORM.LE.0.) GOTO 2077
  477.       YPNORM = 1/ZPNORM
  478.       GOTO 2777
  479. 2077  YPNORM = 1.D69
  480. 2777  IF (IPED.EQ.1.AND.ZPNORM.GT.0.) IPED=2
  481. C
  482. C**      IF(IXTYP.GT.5) IXTYP=5
  483. C
  484.       GO TO 14
  485. C**
  486. C** FOLLOWING FOR INCIDENT PLANE WAVE OR ELEMENTARY CURRENT SOURCE
  487. C**
  488. 27    IF (IXTYP.EQ.0.OR.IXTYP.GE.5) NTSOL=0
  489.       IXTYP=ITMP1
  490.       NTHI=ITMP2
  491.       NPHI=ITMP3
  492.       MASYM=ITMP4/10
  493.       XPR1=TMP1
  494.       XPR2=TMP2
  495.       XPR3=TMP3
  496.       XPR4=TMP4
  497.       XPR5=TMP5
  498.       XPR6=TMP6
  499.       NSANT=0
  500.       NVQD=0
  501.       THETIS=XPR1
  502.       PHISS=XPR2
  503.       GO TO 14
  504. C
  505. C     NETWORK PARAMETERS
  506. C
  507. 28    IF (IFLOW.EQ.6) GO TO 29
  508.       NONET=0
  509.       NTSOL=0
  510.       IFLOW=6
  511.       IF (IGO.GT.3) IGO=3
  512.       IF (ITMP2.EQ.(-1)) GO TO 14
  513. 29    NONET=NONET+1
  514.       IF (NONET.LE.NETMX) GO TO 30
  515.       WRITE(IW,142)
  516.       STOP
  517. 30    NTYP(NONET)=2
  518.       IF (AIN.EQ.ATST(6)) NTYP(NONET)=1
  519.       ISEG1(NONET)=ISEGNO(ITMP1,ITMP2,LD,ITAG)
  520.       ISEG2(NONET)=ISEGNO(ITMP3,ITMP4,LD,ITAG)
  521.       X11R(NONET)=TMP1
  522.       X11I(NONET)=TMP2
  523.       X12R(NONET)=TMP3
  524.       X12I(NONET)=TMP4
  525.       X22R(NONET)=TMP5
  526.       X22I(NONET)=TMP6
  527.       IF (NTYP(NONET).EQ.1.OR.TMP1.GT.0.) GO TO 14
  528.       NTYP(NONET)=3
  529.       X11R(NONET)=-TMP1
  530. C
  531. C     PLOT FLAGS
  532. C
  533. 330   IPLP1=ITMP1
  534.       IPLP2=ITMP2
  535.       IPLP3=ITMP3
  536.       IPLP4=ITMP4
  537. C***
  538.       GO TO 14
  539. C
  540. C     PRINT CONTROL FOR CURRENT
  541. C
  542. 31    IPTFLG=ITMP1
  543.       IPTAG=ITMP2
  544.       IPTAGF=ITMP3
  545.       IPTAGT=ITMP4
  546.       IF(ITMP3.EQ.0.AND.IPTFLG.NE.-1)IPTFLG=-2
  547.       IF (ITMP4.EQ.0) IPTAGT=IPTAGF
  548.       GO TO 14
  549. C
  550. C     WRITE CONTROL FOR CHARGE
  551. C
  552. 319   IPTFLQ=ITMP1
  553.       IPTAQ=ITMP2
  554.       IPTAQF=ITMP3
  555.       IPTAQT=ITMP4
  556.       IF(ITMP3.EQ.0.AND.IPTFLQ.NE.-1)IPTFLQ=-2
  557.       IF(ITMP4.EQ.0)IPTAQT=IPTAQF
  558.       GO TO 14
  559. C
  560. C     NEAR FIELD CALCULATION PARAMETERS
  561. C
  562. 208   NFEH=1
  563.       GO TO 209
  564. 32    NFEH=0
  565. 209   IF (.NOT.(IFLOW.EQ.8.AND.NFRQ.NE.1)) GO TO 33
  566.       WRITE(IW,143)
  567. 33    NEAR=ITMP1
  568.       NRX=ITMP2
  569.       NRY=ITMP3
  570.       NRZ=ITMP4
  571.       XNR=TMP1
  572.       YNR=TMP2
  573.       ZNR=TMP3
  574.       DXNR=TMP4
  575.       DYNR=TMP5
  576.       DZNR=TMP6
  577.       IFLOW=8
  578.       IF (NFRQ.NE.1) GO TO 14
  579.       GO TO (41,46,53,71,72), IGO
  580. C
  581. C     GROUND REPRESENTATION
  582. C
  583. 34    EPSR2=TMP1
  584.       SIG2=TMP2
  585.       CLT=TMP3
  586.       CHT=TMP4
  587.       IFLOW=9
  588.       GO TO 14
  589. C
  590. C     STANDARD OBSERVATION ANGLE PARAMETERS
  591. C
  592. 36    IFAR=ITMP1
  593.       NTH=ITMP2
  594.       NPH=ITMP3
  595.       IF (NTH.EQ.0) NTH=1
  596.       IF (NPH.EQ.0) NPH=1
  597.       IPD=ITMP4/10
  598.       IAVP=ITMP4-IPD*10
  599.       INOR=IPD/10
  600.       IPD=IPD-INOR*10
  601.       IAX=INOR/10
  602.       INOR=INOR-IAX*10
  603.       IF (IAX.NE.0) IAX=1
  604.       IF (IPD.NE.0) IPD=1
  605.       IF (NTH.LT.2.OR.NPH.LT.2) IAVP=0
  606.       IF (IFAR.EQ.1) IAVP=0
  607.       THETS=TMP1
  608.       PHIS=TMP2
  609.       DTH=TMP3
  610.       DPH=TMP4
  611.       RFLD=TMP5
  612.       GNOR=TMP6
  613.       IFLOW=10
  614.       GO TO (41,46,53,71,78), IGO
  615. C
  616. C     WRITE NUMERICAL GREEN'S FUNCTION TAPE
  617. C
  618. 322   IFLOW=12
  619.       IF(ICASX.EQ.0)GO TO 301
  620.       WRITE(IW,302)
  621.       STOP
  622. 301   IRNGF=IRESRV/2
  623.       GO TO (41,46,52,52,52),IGO
  624. C
  625. C     EXECUTE CARD  -  CALC. INCLUDING RADIATED FIELDS
  626. C
  627. 37    IF (IFLOW.EQ.10.AND.ITMP1.EQ.0) GO TO 14
  628.       IF (NFRQ.EQ.1.AND.ITMP1.EQ.0.AND.IFLOW.GT.7) GO TO 14
  629.       IF (ITMP1.NE.0) GO TO 39
  630.       IF (IFLOW.GT.7) GO TO 38
  631.       IFLOW=7
  632.       GO TO 40
  633. 38    IFLOW=11
  634.       GO TO 40
  635. 39    IFAR=0
  636.       RFLD=0.
  637.       IPD=0
  638.       IAVP=0
  639.       INOR=0
  640.       IAX=0
  641.       NTH=91
  642.       NPH=1
  643.       THETS=0.
  644.       PHIS=0.
  645.       DTH=1.0
  646.       DPH=0.
  647.       IF (ITMP1.EQ.2) PHIS=90.
  648.       IF (ITMP1.NE.3) GO TO 40
  649.       NPH=2
  650.       DPH=90.
  651. 40    GO TO (41,46,53,71,78), IGO
  652. C
  653. C     END OF THE MAIN INPUT SECTION
  654. C
  655. C     BEGINNING OF THE FREQUENCY DO LOOP
  656. C
  657. 41    MHZ=1
  658. C***
  659.       IF(N.EQ.0.OR.IFRTMW.EQ.1)GO TO 406
  660.       IFRTMW=1
  661.       DO 445 I=1,N
  662.       XTEMP(I)=X(I)
  663.       YTEMP(I)=Y(I)
  664.       ZTEMP(I)=Z(I)
  665.       SITEMP(I)=T1X(I)
  666.       BITEMP(I)=BI(I)
  667. 445   CONTINUE
  668. 406   IF(M.EQ.0.OR.IFRTMP.EQ.1)GO TO 407
  669.       IFRTMP=1
  670.       J=LD+1
  671.       DO 545 I=1,M
  672.       J=J-1
  673.       XTEMP(J)=X(J)
  674.       YTEMP(J)=Y(J)
  675.       ZTEMP(J)=Z(J)
  676.       BITEMP(J)=BI(J)
  677. 545   CONTINUE
  678. 407   CONTINUE
  679.       FMHZ1=FMHZ
  680. C***
  681. C     CORE ALLOCATION FOR PRIMARY INTERACTON MATRIX.  (A)
  682. C**
  683.       IF(IMAT.NE.0) GOTO 42
  684. CD      WRITE(*,*) ' MAIN: CALL FBLOCK'
  685.       CALL FBLOCK(NPEQ,NEQ,IRESRV,IRNGF,IPSYM,IW)
  686. CD      WRITE(*,*) ' MAIN: RTRN FBLOCK'
  687. C**
  688. 42    IF (MHZ.EQ.1) GO TO 44
  689.       IF (IFRQ.EQ.1) GO TO 43
  690. C      FMHZ=FMHZ+DELFRQ
  691.       FMHZ=FMHZ1+(MHZ-1)*DELFRQ
  692.       GO TO 44
  693. 43    FMHZ=FMHZ*DELFRQ
  694. 44    FR=FMHZ/CVEL
  695.       WLAM=CVEL/FMHZ
  696.       WRITE(IW,145)  FMHZ,WLAM
  697.       WRITE(IW,196) RKH
  698.       IF(IEXK.EQ.1)WRITE(IW,321)
  699. C     FREQUENCY SCALING OF GEOMETRIC PARAMETERS
  700. C***      FMHZS=FMHZ
  701.       IF(N.EQ.0)GO TO 306
  702.       DO 45 I=1,N
  703. C***
  704.       X(I)=XTEMP(I)*FR
  705.       Y(I)=YTEMP(I)*FR
  706.       Z(I)=ZTEMP(I)*FR
  707.       T1X(I)=SITEMP(I)*FR
  708. 45    BI(I)=BITEMP(I)*FR
  709. C***
  710. 306   IF(M.EQ.0)GO TO 307
  711.       FR2=FR*FR
  712.       J=LD+1
  713.       DO 245 I=1,M
  714.       J=J-1
  715. C***
  716.       X(J)=XTEMP(J)*FR
  717.       Y(J)=YTEMP(J)*FR
  718.       Z(J)=ZTEMP(J)*FR
  719. 245   BI(J)=BITEMP(J)*FR2
  720. C***
  721. 307   IGO=2
  722. C     STRUCTURE SEGMENT LOADING
  723. 46    WRITE(IW,146)
  724. C**
  725.        IF(NLOAD.EQ.0) GOTO 470
  726.  
  727. CD      WRITE(*,'(A)') 'MAIN: CALL LOAD'
  728.  
  729.       CALL LOAD(ZARRAY,ZLR,ZLI,ZLC,T1X,BI,LD,ITAG,
  730.      1 LDTYP,LDTAG,LDTAGF,LDTAGT,IW)
  731.  
  732. CD      WRITE(*,'(A)') 'MAIN: RTRN LOAD'
  733.  
  734. 470      CONTINUE
  735.       IF(NLOAD.EQ.0.AND.NLODF.EQ.0)WRITE(IW,147)
  736.       IF(NLOAD.EQ.0.AND.NLODF.NE.0)WRITE(IW,327)
  737. C     GROUND PARAMETER
  738.       WRITE(IW,148)
  739.       IF (KSYMP.EQ.1) GO TO 49
  740.       FRATI=DCMPLX(1.,0.)
  741.       IF (IPERF.EQ.1) GO TO 48
  742.       IF(SIG.LT.0.)SIG=-SIG/(59.96*WLAM)
  743.       EPSC=DCMPLX(EPSR,-SIG*WLAM*59.96)
  744.       ZRATI=1./CDSQRT(EPSC)
  745.       U=ZRATI
  746.       U2=U*U
  747.       IF (NRADL.EQ.0) GO TO 47
  748.       SCRWL=SCRWLT/WLAM
  749.       SCRWR=SCRWRT/WLAM
  750.       T1=FJ*2367.067/FLOAT(NRADL)
  751.       T2=SCRWR*FLOAT(NRADL)
  752.       WRITE(IW,170)  NRADL,SCRWLT,SCRWRT
  753.       WRITE(IW,149)
  754. 47    IF(IPERF.EQ.2)GO TO 328
  755.       WRITE(IW,391)
  756.       GO TO 329
  757. C**
  758. C** FOLLOWING UNFORMATTED READ MUST MATCH PRECISION OF SOMNEC FILE
  759. C**
  760. 328   IF(NXA(1).NE.0) GOTO 401
  761.       WRITE(*,'(A)') ' OPEN UNIT 21 FOR SOMNEC INPUT FILE'
  762.       READ(21)AR1,AR2,AR3,EPSCF,DXA,DYA,XSA,YSA,NXA,NYA
  763.       CLOSE(21)
  764. 401      CONTINUE
  765. C**
  766.       FRATI=(EPSC-1.)/(EPSC+1.)
  767. C      IF(CABS((EPSCF-EPSC)/EPSC).LT.1.E-3)GO TO 400
  768.       IF(ZABS((EPSCF-EPSC)/EPSC).LT.1.E-3)GO TO 400
  769.       WRITE(IW,393) EPSCF,EPSC
  770.       STOP
  771. 400   WRITE(IW,392)
  772. 329   WRITE(IW,150) EPSR,SIG,EPSC
  773.       GO TO 50
  774. 48    WRITE(IW,151)
  775.       GO TO 50
  776. 49    WRITE(IW,152)
  777. 50    CONTINUE
  778. C * * *
  779. C     FILL AND FACTOR PRIMARY INTERACTION MATRIX
  780. C
  781.  
  782. CD      WRITE(*,'(A)') 'MAIN: CALL SECOND'
  783.  
  784.       CALL SECOND (TIM1)
  785.  
  786. CD      WRITE(*,'(A)') 'MAIN: RTRN SECOND'
  787.  
  788.       IF(ICASX.NE.0)GO TO 324
  789. C**
  790. CD      WRITE(*,*) ' MAIN: CALL CMSET'
  791. C**
  792.       CALL CMSET(CM,SCRATC,ZARRAY,T1X,T1Y,T1Z,T2X,T2Y,T2Z,X,Y,Z,
  793.      1 BI,SALP,ICON1,ICON2,ICONX,NEQ,LD,LD2,IRESRV)
  794. C**
  795. CD      WRITE(*,*) ' MAIN: RTRN CMSET'
  796. C**
  797.       CALL SECOND (TIM2)
  798.       TIM=TIM2-TIM1
  799. C
  800. C**
  801. CD      WRITE(*,*) ' MAIN: CALL FACTRS'
  802. C**
  803.       CALL FACTRS(CM,SCRATC,NPEQ,NEQ,IP,IX,11,12,13,14,LD2,IRESRV)
  804. C**
  805. CD      WRITE(*,*) ' MAIN: RTRN FACTRS'
  806. C**
  807.       GO TO 323
  808. C
  809. C     N.G.F. - FILL B, C, AND D AND FACTOR D-C(INV(A)B)
  810. C
  811. C *****
  812. 324   IF(NEQ2.EQ.0)GO TO 333
  813. C *****
  814. C**
  815. CD      WRITE(*,*) ' MAIN: CALL CMNGF'
  816. C**
  817.       CALL CMNGF(CM(IB11),CM(IC11),CM(ID11),ZARRAY,T1X,T1Y,T1Z,T2X,
  818.      1 T2Y,T2Z,X,Y,Z,BI,SALP,RKH,ICON1,ICON2,ICONX,NPBX,NEQ,NEQ2,
  819.      2 IEXK,LD)
  820. C**
  821. CD      WRITE(*,*) ' MAIN: RTRN CMNGF'
  822. C**
  823.       CALL SECOND (TIM2)
  824.       TIM=TIM2-TIM1
  825. C**
  826. CD      WRITE(*,*) ' MAIN: CALL FACGF'
  827. C**
  828.       CALL FACGF(CM,CM(IB11),CM(IC11),CM(ID11),CM(IX11),SCRATC,
  829.      1 IP,IX,NP,N1,MP,M1,NEQ,NEQ2,LD2,IRESRV)
  830. C**
  831. CD      WRITE(*,*) ' MAIN: RTRN FACGF'
  832. C**
  833. CD      WRITE(*,*) 'MAIN: CALL SECOND'
  834. 323   CALL SECOND (TIM1)
  835. CD      WRITE(*,*) 'MAIN: RTRN SECOND'
  836.       TIM2=TIM1-TIM2
  837.       IF(TIM .LT.0.) TIM =TIM  + 86400.
  838.       IF(TIM2.LT.0.) TIM2=TIM2 + 86400.
  839.       WRITE(IW,153)  TIM/60.,TIM2/60.
  840. CD     WRITE(* ,153)  TIM/60.,TIM2/60.
  841. 333   IGO=3
  842.       NTSOL=0
  843.       IF(IFLOW.NE.12)GO TO 53
  844. 52      CONTINUE
  845. C**
  846. C**   WRITE N.G.F. FILE TO 'TAPE.[IGFL]'
  847. C**
  848. CD      WRITE(*,*) ' MAIN: CALL GFOUT'
  849. C**
  850.       CALL GFOUT(CM,ZARRAY,X,Y,Z,T1X,BI,T1Y,T1Z,SALP,
  851.      1 ICON1,ICON2,ITAG,IP,IW,IGFL,LD,LD2,IRESRV)
  852. C**
  853. CD      WRITE(*,*) ' MAIN: RTRN GFOUT'
  854. C**
  855.       GO TO 14
  856. C
  857. C     EXCITATION SET UP (RIGHT HAND SIDE, -E INC.)
  858. C
  859. 53    NTHIC=1
  860.       NPHIC=1
  861.       INC=1
  862.       NPRINT=0
  863. 54    IF (IXTYP.EQ.0.OR.IXTYP.GE.5) GO TO 56
  864.       IF (IPTFLG.LE.0.OR.IXTYP.EQ.4) WRITE(IW,154)
  865.       TMP5=TA*XPR5
  866.       TMP4=TA*XPR4
  867.       IF (IXTYP.NE.4) GO TO 55
  868.       TMP1=XPR1/WLAM
  869.       TMP2=XPR2/WLAM
  870.       TMP3=XPR3/WLAM
  871.       TMP6=XPR6/(WLAM*WLAM)
  872.       WRITE(IW,156)  XPR1,XPR2,XPR3,XPR4,XPR5,XPR6
  873.       GO TO 56
  874. 55    TMP1=TA*XPR1
  875.       TMP2=TA*XPR2
  876.       TMP3=TA*XPR3
  877.       TMP6=XPR6
  878.       IF (IPTFLG.LE.0) WRITE(IW,155) XPR1,XPR2,XPR3,HPOL(IXTYP),XPR6
  879. 56      CONTINUE
  880. C**
  881. CD      WRITE(*,*) ' MAIN: CALL ETMNS'
  882. C**
  883.       CALL ETMNS(CUR,ZARRAY,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,
  884.      1 T2Z,TMP1,TMP2,TMP3,TMP4,TMP5,TMP6,ICON1,ICON2,LD,LD2,LD3,
  885.      2 IXTYP)
  886. C**
  887. CD      WRITE(*,*) ' MAIN: RTRN ETMNS'
  888. C**
  889. C
  890. C     MATRIX SOLVING  (NETWK CALLS SOLVES)
  891. C
  892.       IF((NONET.EQ.0.).OR.(INC.GT.1).OR.(NAMPRT.NE.0)) GO TO 60
  893.       WRITE(IW,158)
  894. C      WRITE(* ,158)
  895.       ITMP3=0
  896.       ITMP1=NTYP(1)
  897.       DO 59 I=1,2
  898.       IF (ITMP1.EQ.3) ITMP1=2
  899.       IF (ITMP1.EQ.2) WRITE(IW,159)
  900.       IF (ITMP1.EQ.1) WRITE(IW,160)
  901.       DO 58 J=1,NONET
  902.       ITMP2=NTYP(J)
  903.       IF ((ITMP2/ITMP1).EQ.1) GO TO 57
  904.       ITMP3=ITMP2
  905.       GO TO 58
  906. 57    ITMP4=ISEG1(J)
  907.       ITMP5=ISEG2(J)
  908.       IF (ITMP2.GE.2.AND.X11I(J).LE.0.) X11I(J)=WLAM*SQRT((X(ITMP5)
  909.      1 -X(ITMP4))**2+(Y(ITMP5)-Y(ITMP4))**2+(Z(ITMP5)-Z(ITMP4))**2)
  910.       WRITE(IW,157) ITAG(ITMP4),ITMP4,ITAG(ITMP5),ITMP5,X11R(J),
  911.      1 X11I(J),X12R(J),X12I(J),X22R(J),X22I(J),PNET(ITMP2)
  912. 58    CONTINUE
  913.       IF (ITMP3.EQ.0) GO TO 60
  914.       ITMP1=ITMP3
  915. 59    CONTINUE
  916. 60    CONTINUE
  917.       IF (INC.GT.1.AND.IPTFLG.GT.0) NPRINT=1
  918. C**
  919. CD      WRITE(*,*) ' MAIN: CALL NETWK'
  920. C**
  921.        CALL NETWK(CM,CM(IB11),CM(IC11),CM(ID11),CUR,RHS,SCRATC,
  922.      1 AIR,AII,BIR,BII,CIR,CII,T1X,T1Y,T1Z,T2X,T2Y,T2Z,BI,
  923.      2 ICON1,ICON2,ITAG,IP,IW,LD,LD2,LD3,IRESRV)
  924. C**
  925. CD      WRITE(*,*) ' MAIN: RTRN NETWK'
  926. C**
  927. 325      CONTINUE
  928. C
  929.       NTSOL=1
  930.       IF (IPED.EQ.0) GO TO 61
  931.       ITMP1=MHZ+4*(MHZ-1)
  932.       IF (ITMP1.GT.(NORMF-3)) GO TO 61
  933.       FNORM(ITMP1)=DREAL(ZPED)
  934.       FNORM(ITMP1+1)=DIMAG(ZPED)
  935.       FNORM(ITMP1+2)=ZABS(ZPED)
  936.       FNORM(ITMP1+3)=CANG(1.D0*ZPED)
  937.       IF (IPED.EQ.2) GO TO 61
  938.       IF (FNORM(ITMP1+2).GT.ZPNORM) ZPNORM=FNORM(ITMP1+2)
  939. 61    CONTINUE
  940. C
  941. C     PRINTING STRUCTURE CURRENTS
  942. C
  943.       IF(N.EQ.0)GO TO 308
  944.       IF (IPTFLG.EQ.(-1)) GO TO 63
  945. C***
  946. C***    PT STUFF - RCV CURRENT OUTPUT   RWA 29 MAR 89  CHANGE 1 LINE
  947. C***
  948.       IF (IPTFLG.GT.0) GO TO 620
  949.       WRITE(IW,161)
  950.       WRITE(IW,162)
  951.       GO TO 63
  952. C***
  953. C***    PT STUFF - RCV CURRENT OUTPUT  RWA 29 MAR 89  ADD 3 LINES
  954. C***
  955. 620   IF (IPTFLG.NE.9.OR.INC.GT.1) GO TO 62
  956.       WRITE(IW,1630) XPR3,HPOL(IXTYP),XPR6
  957.       GO TO 63
  958. 62    IF (IPTFLG.EQ.3.OR.INC.GT.1) GO TO 63
  959.       WRITE(IW,163)  XPR3,HPOL(IXTYP),XPR6
  960. 63    PLOSS=0.
  961.       ITMP1=0
  962.       JUMP=IPTFLG+1
  963.       DO 69 I=1,N
  964.       CURI=CUR(I)*WLAM
  965.       CMAG=ZABS(CURI)
  966.       PH=CANG(CURI)
  967.       IF (NLOAD.EQ.0.AND.NLODF.EQ.0) GO TO 64
  968.       IF (ABS(DREAL(ZARRAY(I))).LT.1.D-20) GO TO 64
  969.       PLOSS=PLOSS+.5*CMAG*CMAG*DREAL(ZARRAY(I))*T1X(I)
  970. 64    IF (JUMP) 68,69,65
  971. 65    IF (IPTAG.EQ.0) GO TO 66
  972.       IF (ITAG(I).NE.IPTAG) GO TO 69
  973. 66    ITMP1=ITMP1+1
  974.       IF (ITMP1.LT.IPTAGF.OR.ITMP1.GT.IPTAGT) GO TO 69
  975.       IF (IPTFLG.EQ.0) GO TO 68
  976. C***
  977. C***    PT STUFF - RCV CURRENT OUTPUT  RWA  29 MAR 89    CHANGE 1 LINE
  978. C***
  979.       IF (IPTFLG.LT.2.OR.IPTFLG.NE.9.OR.INC.GT.NORMF) GO TO 67
  980.       FNORM(INC)=CMAG
  981.       ISAVE=I
  982. C***
  983. C***    PT STUFF  RCV CURRENT OUTPUT  RWA 29 MAR 89  CHNG 1, ADD 7 LNS
  984. C***
  985. 67    IF(IPTFLG.NE.3.AND.IPTFLG.LT.9) WRITE(IW,164) XPR1,XPR2,CMAG,PH,I
  986.       IF (IPTFLG.EQ.8) GO TO 677
  987.       IF (IPTFLG.EQ.9) GO TO 688
  988.       GO TO 69
  989. 677   WRITE(8,*) XPR1,XPR2,CMAG,PH,I
  990.       GO TO 69
  991. 688   WRITE(IW,1640) XPR1,XPR2,CURI,I
  992.       WRITE(8,*) XPR1,XPR2,CURI,I
  993. 68    WRITE(IW,165)  I,ITAG(I),X(I),Y(I),Z(I),T1X(I),CURI,CMAG,PH
  994. C***
  995. C***    PL STUFF   OUTPUT CURRENTS FOR NEC/BSC (GTD CODE)  ADD 2 LINES
  996. C***
  997.       IF(IPLP1.NE.1) GO TO 69
  998.       IF(IPLP2.EQ.1) WRITE(8,*) CURI
  999. C***
  1000. C***    PL STUFF   OUTPUT CURRENTS FOR CURRPLOT   ADD 1 LINE
  1001. C***
  1002.       IF(IPLP2.EQ.2) WRITE(8,*) CMAG,PH
  1003. 69    CONTINUE
  1004.       IF(IPTFLQ.EQ.(-1))GO TO 308
  1005.       WRITE(IW,315)
  1006.       ITMP1=0
  1007.       FR=1.E-6/FMHZ
  1008.       DO 316 I=1,N
  1009.       IF(IPTFLQ.EQ.(-2))GO TO 318
  1010.       IF(IPTAQ.EQ.0)GO TO 317
  1011.       IF(ITAG(I).NE.IPTAQ)GO TO 316
  1012. 317   ITMP1=ITMP1+1
  1013.       IF(ITMP1.LT.IPTAQF.OR.ITMP1.GT.IPTAQT)GO TO 316
  1014. 318   CURI=FR*DCMPLX(-BII(I),BIR(I))
  1015.       CMAG=ZABS(CURI)
  1016.       PH=CANG(CURI)
  1017.       WRITE(IW,165) I,ITAG(I),X(I),Y(I),Z(I),T1X(I),CURI,CMAG,PH
  1018. 316   CONTINUE
  1019. 308   IF(M.EQ.0)GO TO 310
  1020.       WRITE(IW,197)
  1021.       J=N-2
  1022.       ITMP1=LD+1
  1023.       DO 309 I=1,M
  1024.       J=J+3
  1025.       ITMP1=ITMP1-1
  1026.       EX=CUR(J)
  1027.       EY=CUR(J+1)
  1028.       EZ=CUR(J+2)
  1029.       ETH=EX*T1X(ITMP1)+EY*T1Y(ITMP1)+EZ*T1Z(ITMP1)
  1030.       EPH=EX*T2X(ITMP1)+EY*T2Y(ITMP1)+EZ*T2Z(ITMP1)
  1031.       ETHM=ZABS(ETH)
  1032.       ETHA=CANG(ETH)
  1033.       EPHM=ZABS(EPH)
  1034.       EPHA=CANG(EPH)
  1035. C***
  1036. C**     PL STUFF   OUTPUT CURRENTS   RWA 29 MAR 89  CHANG 2, ADD 5
  1037.       WRITE(IW,198) I,X(ITMP1),Y(ITMP1),Z(ITMP1),ETHM,ETHA,EPHM,EPHA,
  1038.      1EX,EY,EZ
  1039.       IF(IPLP1.NE.1) GO TO 309
  1040.       IF(IPLP3.EQ.1) WRITE(8,*) EX
  1041.       IF(IPLP3.EQ.2) WRITE(8,*) EY
  1042.       IF(IPLP3.EQ.3) WRITE(8,*) EZ
  1043.       IF(IPLP3.EQ.4) WRITE(8,*) EX,EY,EZ
  1044. 309   CONTINUE
  1045. 310   IF (IXTYP.NE.0.AND.IXTYP.LT.5) GO TO 70
  1046.       TMP1=PIN-PNLS-PLOSS
  1047.       TMP2=100.*TMP1/PIN
  1048.       WRITE(IW,166)  PIN,TMP1,PLOSS,PNLS,TMP2
  1049. 70    CONTINUE
  1050. C
  1051.       IGO=4
  1052.       IF(NCOUP.LE.0) GOTO 710
  1053. C**
  1054. CD      WRITE(*,'(A)') 'MAIN: CALL COUPLE'
  1055.       CALL COUPLE(IW,CUR,WLAM,LD,LD3,ITAG)
  1056. CD      WRITE(*,'(A)') 'MAIN: RTRN COUPLE'
  1057. C**
  1058. 710      CONTINUE
  1059.       IF (IFLOW.NE.7) GO TO 71
  1060.       IF (IXTYP.GT.0.AND.IXTYP.LT.4) GO TO 113
  1061.       IF (NFRQ.NE.1) GO TO 120
  1062.       WRITE(IW,135)
  1063.       GO TO 14
  1064. 71    IGO=5
  1065. C
  1066. C     NEAR FIELD CALCULATION
  1067. C
  1068. 72    IF (NEAR.EQ.(-1)) GO TO 78
  1069. CD      WRITE(*,'(A)') 'MAIN: CALL NFPAT'
  1070.       CALL NFPAT(X,Y,Z,T1X,BI,SALP,T1X,T1Y,T1Z,
  1071.      1 T2X,T2Y,T2Z,ICON1,ICON2,AIR,AII,BIR,BII,CIR,CII,CUR,IW,LD,LD3)
  1072. CD      WRITE(*,'(A)') 'MAIN: RTRN NFPAT'
  1073.       IF (MHZ.EQ.NFRQ) NEAR=-1
  1074.       IF (NFRQ.NE.1) GO TO 78
  1075.       WRITE(IW,135)
  1076.       GO TO 14
  1077. C
  1078. C     STANDARD FAR FIELD CALCULATION
  1079. C
  1080. 78    IF(IFAR.EQ.-1)GO TO 113
  1081.       PINR=PIN
  1082.       PNLR=PNLS
  1083. CD      WRITE(*,'(A)') 'MAIN: CALL RDPAT'
  1084.       CALL RDPAT(CUR,GAIN,AIR,AII,BIR,BII,CIR,CII,T1X,T1Y,T1Z,
  1085.      1 BI,SALP,X,Y,Z,LD,LD3,LD4,IW)
  1086. CD      WRITE(*,'(A)') 'MAIN: RTRN RDPAT'
  1087. 113   IF (IXTYP.EQ.0.OR.IXTYP.GE.4) GO TO 119
  1088.       NTHIC=NTHIC+1
  1089.       INC=INC+1
  1090.       XPR1=XPR1+XPR4
  1091.       IF (NTHIC.LE.NTHI) GO TO 54
  1092.       NTHIC=1
  1093.       XPR1=THETIS
  1094.       XPR2=XPR2+XPR5
  1095.       NPHIC=NPHIC+1
  1096.       IF (NPHIC.LE.NPHI) GO TO 54
  1097.       NPHIC=1
  1098.       XPR2=PHISS
  1099. C***
  1100. C***    PT STUFF  RCV CURRENT OUTPUT  RWA 29 MAR 89  CHANGE 1 LINE
  1101. C***
  1102.       IF (IPTFLG.LT.2.OR.IPTFLG.GT.7) GO TO 119
  1103. C     NORMALIZED RECEIVING PATTERN PRINTED
  1104.       ITMP1=NTHI*NPHI
  1105.       IF (ITMP1.LE.NORMF) GO TO 114
  1106.       ITMP1=NORMF
  1107.       WRITE(IW,181)
  1108. 114   TMP1=FNORM(1)
  1109.       DO 115 J=2,ITMP1
  1110.       IF (FNORM(J).GT.TMP1) TMP1=FNORM(J)
  1111. 115   CONTINUE
  1112.       WRITE(IW,182)  TMP1,XPR3,HPOL(IXTYP),XPR6,ISAVE
  1113.       DO 118 J=1,NPHI
  1114.       ITMP2=NTHI*(J-1)
  1115.       DO 116 I=1,NTHI
  1116.       ITMP3=I+ITMP2
  1117.       IF (ITMP3.GT.ITMP1) GO TO 117
  1118.       TMP2=FNORM(ITMP3)/TMP1
  1119.       TMP3=DB20(1.D0*TMP2)
  1120.       WRITE(IW,183)  XPR1,XPR2,TMP3,TMP2
  1121.       XPR1=XPR1+XPR4
  1122. 116   CONTINUE
  1123. 117   XPR1=THETIS
  1124.       XPR2=XPR2+XPR5
  1125. 118   CONTINUE
  1126.       XPR2=PHISS
  1127. 119   IF (MHZ.EQ.NFRQ) IFAR=-1
  1128.       IF (NFRQ.NE.1) GO TO 120
  1129.       WRITE(IW,135)
  1130.       GO TO 14
  1131. 120   MHZ=MHZ+1
  1132.       IF (MHZ.LE.NFRQ) GO TO 42
  1133.       IF (IPED.EQ.0) GO TO 123
  1134.       IF(NVQD.LT.1)GO TO 199
  1135.       WRITE(IW,184) IVQD(NVQD),ZPNORM
  1136.       GO TO 204
  1137. 199   WRITE(IW,184)  ISANT(NSANT),ZPNORM
  1138. 204   ITMP1=NFRQ
  1139.       IF (ITMP1.LE.(NORMF/4)) GO TO 121
  1140.       ITMP1=NORMF/4
  1141.       WRITE(IW,185)
  1142. 121   IF (IFRQ.EQ.0) TMP1=FMHZ-(NFRQ-1)*DELFRQ
  1143.       IF (IFRQ.EQ.1) TMP1=FMHZ/(DELFRQ**(NFRQ-1))
  1144.       DO 122 I=1,ITMP1
  1145.       ITMP2=I+4*(I-1)
  1146.       TMP2=FNORM(ITMP2)/ZPNORM
  1147.       TMP3=FNORM(ITMP2+1)/ZPNORM
  1148.       TMP4=FNORM(ITMP2+2)/ZPNORM
  1149.       TMP5=FNORM(ITMP2+3)
  1150. C***
  1151. C***      VSWR STUFF  RWA 29 MAR 89   ADD 7 LINES, CHANGE 2
  1152. C***
  1153.       SWRA = SQRT(((TMP2+1)**2)+TMP3**2)
  1154.       SWRB = SQRT(((TMP2-1)**2)+TMP3**2)
  1155.       SWR = (SWRA+SWRB)/(SWRA-SWRB)
  1156.       WRITE(IW,186) TMP1,FNORM(ITMP2),FNORM(ITMP2+1),FNORM(ITMP2+2),
  1157.      1FNORM(ITMP2+3),TMP2,TMP3,TMP4,TMP5,SWR
  1158.       IF (IPLP1.NE.4) GO TO 1122
  1159.       WRITE(8,1866) TMP1,FNORM(ITMP2),FNORM(ITMP2+1),
  1160.      1TMP2,TMP3,SWR
  1161. 1122  CONTINUE
  1162.       IF (IFRQ.EQ.0) TMP1=TMP1+DELFRQ
  1163.       IF (IFRQ.EQ.1) TMP1=TMP1*DELFRQ
  1164. 122   CONTINUE
  1165. C***
  1166. C***    ADMITTANCE STUFF  RWA 29 MAR 89   32 LINES
  1167. C***
  1168.       IF (NVQD.LT.1) GO TO 1999
  1169.       WRITE (IW,1844) IVQD(NVQD),YPNORM
  1170.       GO TO 2044
  1171. 1999  WRITE (IW,1844) ISANT(NSANT), YPNORM
  1172. 2044  ITMP1 = NFRQ
  1173.       IF (ITMP1.LE.(NORMF/4)) GO TO 1211
  1174.       ITMP1 = NORMF/4
  1175.       WRITE (IW,185)
  1176. 1211  IF (IFRQ.EQ.0) TMP1=FMHZ-(NFRQ-1)*DELFRQ
  1177.       IF (IFRQ.EQ.1) TMP1=FMHZ/(DELFRQ**(NFRQ-1))
  1178.       DO 1222 I=1,ITMP1
  1179.       ITMP2 =I+4*(I-1)
  1180.       YTMP2 = FNORM(ITMP2)/(FNORM(ITMP2)**2+FNORM(ITMP2+1)**2)
  1181.       YTMP3 = -FNORM(ITMP2+1)/(FNORM(ITMP2)**2+FNORM(ITMP2+1)**2)
  1182.       YTMP4 = 1./FNORM(ITMP2+2)
  1183.       YTMP5 = -FNORM(ITMP2+3)
  1184.       YNTMP2 = YTMP2/YPNORM
  1185.       YNTMP3 = YTMP3/YPNORM
  1186.       YNTMP4 = YTMP4/YPNORM
  1187.       YNTMP5 = YTMP5
  1188.       SWRA = SQRT((((YNTMP2)+1)**2)+(YNTMP3)**2)
  1189.       SWRB = SQRT((((YNTMP2)-1)**2)+(YNTMP3)**2)
  1190.       SWR = (SWRA+SWRB)/(SWRA-SWRB)
  1191.       WRITE (IW,186) TMP1, YTMP2, YTMP3, YTMP4, YTMP5,
  1192.      1YNTMP2, YNTMP3, YNTMP4, YNTMP5, SWR
  1193.       IF (IPLP1.NE.5) GO TO 1123
  1194.       WRITE (8,1866) TMP1, YTMP2, YTMP3,
  1195.      1YNTMP2, YNTMP3, SWR
  1196. 1123  CONTINUE
  1197.       IF (IFRQ.EQ.0) TMP1=TMP1+DELFRQ
  1198.       IF (IFRQ.EQ.1) TMP1=TMP1*DELFRQ
  1199. 1222  CONTINUE
  1200.       WRITE(IW,135)
  1201. 123   CONTINUE
  1202.       NFRQ=1
  1203.       MHZ=1
  1204.       GO TO 14
  1205. 125   FORMAT (A2,19A4)
  1206. 126   FORMAT  (1H1)
  1207. 127   FORMAT (///,33X,36H************************************,//,36X,
  1208.      1 31HNUMERICAL ELECTROMAGNETICS CODE,//,33X,
  1209.      2 36H************************************)
  1210. 128   FORMAT (////,37X,24H- - - - COMMENTS - - - -,//)
  1211. 129   FORMAT (25X,20A4)
  1212. 130   FORMAT (///,10X,34HINCORRECT LABEL FOR A COMMENT CARD)
  1213. 135   FORMAT (/////)
  1214. 136   FORMAT (A2,I3,3I5,6E10.3)
  1215. 137   FORMAT (1X, 19H***** DATA CARD NO.,I3,3X,A2,1X,I3,3(1X,I5),
  1216.      1 6(1X,1P,E12.5))
  1217. 138   FORMAT (///,10X,45HFAULTY DATA CARD LABEL AFTER GEOMETRY SECTION)
  1218. 139   FORMAT (///,10X,48HNUMBER OF LOADING CARDS EXCEEDS STORAGE ALLOTTE
  1219.      1D)
  1220. 140   FORMAT (///,10X,31HDATA FAULT ON LOADING CARD NO.=,I5,5X,11HITAG S
  1221.      1TEP1=,I5,29H  IS GREATER THAN ITAG STEP2=,I5)
  1222. 141   FORMAT (///,10X,51HNUMBER OF EXCITATION CARDS EXCEEDS STORAGE ALLO
  1223.      1TTED)
  1224. 142   FORMAT (///,10X,48HNUMBER OF NETWORK CARDS EXCEEDS STORAGE ALLOTTE
  1225.      1D)
  1226. 143   FORMAT(///,10X,79HWHEN MULTIPLE FREQUENCIES ARE REQUESTED, ONLY ON
  1227.      1E NEAR FIELD CARD CAN BE USED -,/,10X,22HLAST CARD READ IS USED)
  1228. 145   FORMAT (////,33X,33H- - - - - - FREQUENCY - - - - - -,//,36X,10HFR
  1229.      1EQUENCY=,1P,E11.4,4H MHZ,/,36X,11HWAVELENGTH=,E11.4,7H METERS)
  1230. 146   FORMAT (///,30X,40H - - - STRUCTURE IMPEDANCE LOADING - - -)
  1231. 147   FORMAT (/ ,35X,28HTHIS STRUCTURE IS NOT LOADED)
  1232. 148   FORMAT (///,34X,31H- - - ANTENNA ENVIRONMENT - - -,/)
  1233. 149   FORMAT (40X,21HMEDIUM UNDER SCREEN -)
  1234. 150   FORMAT (40X,27HRELATIVE DIELECTRIC CONST.=,F7.3,/,40X,13HCONDUCTIV
  1235.      1ITY=,1P,E10.3,11H MHOS/METER,/,40X,28HCOMPLEX DIELECTRIC CONSTANT=
  1236.      1,2E12.5)
  1237. 151   FORMAT (  42X,14HPERFECT GROUND)
  1238. 152   FORMAT (  44X,10HFREE SPACE)
  1239. 153   FORMAT (///,32X,25H- - - MATRIX TIMING - - -,//,24X,5HFILL=,F9.3,
  1240.      115H MIN.,  FACTOR=,F9.3,5H MIN.)
  1241. 154   FORMAT (///,40X,22H- - - EXCITATION - - -)
  1242. 155   FORMAT (/,4X,10HPLANE WAVE,4X,6HTHETA=,F7.2,11H DEG,  PHI=,F7.2,
  1243.      1 11H DEG,  ETA=,F7.2,13H DEG,  TYPE -,A6,15H=  AXIAL RATIO=,F6.3)
  1244. 156   FORMAT (/,31X,17HPOSITION (METERS),14X,18HORIENTATION (DEG)=/,28X,
  1245.      11HX,12X,1HY,12X,1HZ,10X,5HALPHA,5X,4HBETA,4X,13HDIPOLE MOMENT,//
  1246.      2 ,4X,14HCURRENT SOURCE,1X,3(3X,F10.5),1X,2(3X,F7.2),4X,F8.3)
  1247. 157   FORMAT (4X,4(I5,1X),1P,6(3X,E11.4),3X,A8)
  1248. 158   FORMAT (///,44X,24H- - - NETWORK DATA - - -)
  1249. 159   FORMAT (/,6X,18H- FROM -    - TO -,11X,17HTRANSMISSION LINE,15X,36
  1250.      1H-  -  SHUNT ADMITTANCES (MHOS)  -  -,14X,4HLINE,/,6X,21HTAG  SEG.
  1251.      2   TAG  SEG.,6X,9HIMPEDANCE,6X,6HLENGTH,12X,11H- END ONE -,17X,11H
  1252.      3- END TWO -,12X,4HTYPE,/    ,6X,21HNO.   NO.   NO.   NO.,9X,4HOHMS
  1253.      4,8X,6HMETERS,9X, 4HREAL,10X,5HIMAG.,9X,4HREAL,10X,5HIMAG.)
  1254. 160   FORMAT (/,6X,8H- FROM -,4X,6H- TO -,26X,45H-  -  ADMITTANCE MATRIX
  1255.      1 ELEMENTS (MHOS)  -  -,/    ,6X,21HTAG  SEG.   TAG  SEG.,13X,9H(ON
  1256.      2E,ONE),19X,    9H(ONE,TWO),19X,9H(TWO,TWO),/ ,6X,21HNO.   NO.   NO
  1257.      3.   NO.,8X,4HREAL,10X,5HIMAG.,9X,4HREAL,10X,5HIMAG.,9X,4HREAL,
  1258.      4 10X,5HIMAG.)
  1259. 161   FORMAT (///,29X,33H- - - CURRENTS AND LOCATION - - -,//,33X,24HDIS
  1260.      1TANCES IN WAVELENGTHS)
  1261. 162   FORMAT (  //,2X,4HSEG.,2X,3HTAG,4X,21HCOORD. OF SEG. CENTER,5X,
  1262.      1 4HSEG.,12X,26H- - - CURRENT (AMPS) - - -,/,2X,3HNO.,3X,3HNO.,
  1263.      2 5X,1HX,8X,1HY,8X,1HZ,6X,6HLENGTH,5X,4HREAL,8X,5HIMAG.,7X,4HMAG.,
  1264.      3 8X,5HPHASE)
  1265. 163   FORMAT (///,33X,40H- - - RECEIVING PATTERN PARAMETERS - - -,/  ,43
  1266.      1X,4HETA=,F7.2,8H DEGREES,/,43X,6HTYPE -,A6,/,43X,12HAXIAL RATIO=,
  1267.      2 F6.3,//   ,11X,5HTHETA,6X,3HPHI,10X,13H-  CURRENT  -,9X,3HSEG,/
  1268.      3,11X,5H(DEG),5X,5H(DEG),7X,9HMAGNITUDE,4X,5HPHASE,6X,3HNO.,/)
  1269. C***
  1270. C***    PT STUFF  RCV CURRENT OUTPUT   RWA 29 MAR 89  ADD 4 LINES
  1271. C***
  1272. 1630  FORMAT (///,33X,40H- - - RECEIVING PATTERN PARAMETERS - - -,/  ,43
  1273.      1X,4HETA=,F7.2,8H DEGREES,/,43X,6HTYPE -,A6,/,43X,12HAXIAL RATIO=,
  1274.      2 F6.3,//   ,11X,5HTHETA,6X,3HPHI,10X,13H-  CURRENT  -,9X,3HSEG,/
  1275.      3,11X,5H(DEG),5X,5H(DEG),7X,9H  REAL   ,4X,5HIMAG.,6X,3HNO.,/)
  1276. 164   FORMAT (10X,2(F7.2,3X),1X,1P,E11.4,3X,0P,F7.2,4X,I5)
  1277. C***
  1278. C***    PT STUFF  RCV CURRENT OUTPUT   RWA 29 MAR 89  ADD 1 LINE
  1279. C***
  1280. 1640  FORMAT (10X,2(F7.2,3X),1X,1P,E11.4,1X,E11.4,2X,I5)
  1281. 165   FORMAT (1X,2I5,3F9.4,F9.5,1X,1P,3E12.4,0P,F9.3)
  1282. 166   FORMAT (///,40X,24H- - - POWER BUDGET - - -,//    ,43X,15HINPUT PO
  1283.      1WER   =,1P,E11.4,6H WATTS,/ ,43X,15HRADIATED POWER=,E11.4,6H WATTS
  1284.      2,/,43X,15HSTRUCTURE LOSS=,E11.4,6H WATTS,/ ,43X,15HNETWORK LOSS  =
  1285.      3, E11.4,6H WATTS,/,43X,15HEFFICIENCY    =,0P,F7.2,8H PERCENT)
  1286. 170   FORMAT (40X,25HRADIAL WIRE GROUND SCREEN,/,40X,   I5,6H WIRES,/,40
  1287.      1X,12HWIRE LENGTH=,F8.2,7H METERS,/,40X,12HWIRE RADIUS=,1P,E10.3,
  1288.      27H METERS)
  1289. 181   FORMAT (///,4X,51HRECEIVING PATTERN STORAGE TOO SMALL,ARRAY TRUNCA
  1290.      1TED)
  1291. 182   FORMAT (///,32X,40H- - - NORMALIZED RECEIVING PATTERN - - -,/,41X,
  1292.      121HNORMALIZATION FACTOR=,1P,E11.4,/,41X,4HETA=,0P,F7.2,8H DEGREES,
  1293.      2/,41X,6HTYPE -,A6,/,41X,12HAXIAL RATIO=,F6.3,/,41X,12HSEGMENT NO.=
  1294.      3,I5,//,21X,5HTHETA,6X,3HPHI,9X,13H-  PATTERN  -,/,21X,5H(DEG),5X,
  1295.      45H(DEG),8X,2HDB,8X,9HMAGNITUDE,/)
  1296. 183   FORMAT (20X,2(F7.2,3X),1X,F7.2,4X,1P,E11.4)
  1297. C***
  1298. C***    VSWR STUFF  RWA 29 MAR 89   8 LINE CHANGES
  1299. C***
  1300. 184   FORMAT (///,36X,32H- - - INPUT IMPEDANCE DATA - - -,/   ,45X,18HSO
  1301.      1URCE SEGMENT NO.,I4,/  ,45X,21HNORMALIZATION FACTOR=,1P,E12.5,//
  1302.      2,7X,5HFREQ.,13X,34H-  -  UNNORMALIZED IMPEDANCE  -  -,21X,   32H-
  1303.      3 -  NORMALIZED IMPEDANCE  -  -,12X,'VSWR'/,
  1304.      |19X,10HRESISTANCE,4X,9HREACTANCE,
  1305.      46X,9HMAGNITUDE,4X,5HPHASE,7X,10HRESISTANCE,4X,9HREACTANCE,6X,
  1306.      5 9HMAGNITUDE,4X,5HPHASE,/    ,8X,3HMHZ,11X,4HOHMS,10X,4HOHMS,11X,
  1307.      6 4HOHMS,5X,7HDEGREES,47X,7HDEGREES,/)
  1308. C***
  1309. C***    ADMITTANCE STUFF  RWA 29 MAR 89   8 LINE CHANGES
  1310. C***
  1311. 1844  FORMAT (///,35X,'- - - INPUT ADMITTANCE DATA - - -',/   ,45X,'SOUR
  1312.      1CE SEGMENT NO.',I4,/  ,45X,21HNORMALIZATION FACTOR=,1P,E12.5,//
  1313.      2,7X,5HFREQ.,12X,'-  -  UNNORMALIZED ADMITTANCE  -  -',20X,   '-
  1314.      3 -  NORMALIZED ADMITTANCE  -  -',10X,'VSWR'/,
  1315.      |19X,'CONDUCTANCE',3X,'SUSCEPTANCE',
  1316.      45X,9HMAGNITUDE,4X,5HPHASE,6X,'CONDUCTANCE',3X,'SUSCEPTANCE',3X,
  1317.      5 9HMAGNITUDE,4X,5HPHASE,/    ,8X,3HMHZ,11X,4HMHOS,10X,4HMHOS,11X,
  1318.      6 4HMHOS,5X,7HDEGREES,47X,7HDEGREES,/)
  1319. 185   FORMAT (///,4X,62HSTORAGE FOR IMPEDANCE NORMALIZATION TOO SMALL, A
  1320.      1RRAY TRUNCATED)
  1321. C***
  1322. C***    VSWR STUFF  RWA 29 MAR 89  2 LINE CHANGES   1 LINE ADD
  1323. C***
  1324. 186   FORMAT (3X,F9.3,2X,1P,2(2X,E12.5),3X,E12.5,2X,0P,F7.2,2X,1P,2(2X,
  1325.      1 E12.5),3X,E12.5,2X,0P,F7.2,3X,F5.2)
  1326. 1866  FORMAT (1X,6E11.3)
  1327. 196   FORMAT(   ////,20X,55HAPPROXIMATE INTEGRATION EMPLOYED FOR SEGMENT
  1328.      1S MORE THAN,F8.3,18H WAVELENGTHS APART)
  1329. 197   FORMAT(   ////,41X,38H- - - - SURFACE PATCH CURRENTS - - - -,//,
  1330.      1 50X,23HDISTANCE IN WAVELENGTHS,/,50X,21HCURRENT IN AMPS/METER,
  1331.      1 //,28X,26H- - SURFACE COMPONENTS - -,19X,34H- - - RECTANGULAR COM
  1332.      1PONENTS - - -,/,6X,12HPATCH CENTER,6X,16HTANGENT VECTOR 1,3X,
  1333.      116HTANGENT VECTOR 2,11X,1HX,19X,1HY,19X,1HZ,/,5X,1HX,6X,1HY,6X,
  1334.      11HZ,5X,4HMAG.,7X,5HPHASE,3X,4HMAG.,7X,5HPHASE,3(4X,4HREAL,6X,
  1335.      1 6HIMAG. ))
  1336. 198   FORMAT(1X,I4,/,1X,3F7.3,2(1P,E11.4,0P,F8.2),1P,6E10.2)
  1337. 201   FORMAT(/,11H RUN TIME =,F10.3)
  1338. 315   FORMAT(///,34X,28H- - - CHARGE DENSITIES - - -,//,36X,
  1339.      1 24HDISTANCES IN WAVELENGTHS,///,2X,4HSEG.,2X,3HTAG,4X,
  1340.      2 21HCOORD. OF SEG. CENTER,5X,4HSEG.,10X,
  1341.      3 31HCHARGE DENSITY (COULOMBS/METER),/,2X,3HNO.,3X,3HNO.,5X,1HX,8X,
  1342.      4 1HY,8X,1HZ,6X,6HLENGTH,5X,4HREAL,8X,5HIMAG.,7X,4HMAG.,8X,5HPHASE)
  1343. 321   FORMAT( /,20X,42HTHE EXTENDED THIN WIRE KERNEL WILL BE USED)
  1344. 303   FORMAT(/,9H ERROR - ,A2,32H CARD IS NOT ALLOWED WITH N.G.F.)
  1345. 327   FORMAT(/,35X,31H LOADING ONLY IN N.G.F. SECTION)
  1346. 302   FORMAT(48H ERROR - N.G.F. IN USE.  CANNOT WRITE NEW N.G.F.)
  1347. 313   FORMAT(/,62H NUMBER OF SEGMENTS IN COUPLING CALCULATION (CP) EXCEE
  1348.      1DS LIMIT)
  1349. 390   FORMAT(78H RADIAL WIRE G. S. APPROXIMATION MAY NOT BE USED WITH SO
  1350.      1MMERFELD GROUND OPTION)
  1351. 391   FORMAT(40X,52HFINITE GROUND.  REFLECTION COEFFICIENT APPROXIMATION
  1352.      1)
  1353. 392   FORMAT(40X,35HFINITE GROUND.  SOMMERFELD SOLUTION)
  1354. 393   FORMAT(/,29H ERROR IN GROUND PARAMETERS -,/,41H COMPLEX DIELECTRIC
  1355.      1 CONSTANT FROM FILE IS,1P,2E12.5,/,32X,9HREQUESTED,2E12.5)
  1356.       END
  1357.